VERSION 5.00
Begin VB.Form frmBounce1b 
   Caption         =   "Bounce1b"
   ClientHeight    =   5235
   ClientLeft      =   1320
   ClientTop       =   825
   ClientWidth     =   6870
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   349
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   458
   Begin VB.TextBox txtFramesPerSecond 
      Height          =   285
      Left            =   1440
      TabIndex        =   4
      Text            =   "20"
      Top             =   4920
      Width           =   375
   End
   Begin VB.TextBox txtNumBalls 
      Height          =   285
      Left            =   1440
      TabIndex        =   3
      Text            =   "20"
      Top             =   4560
      Width           =   375
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "Start"
      Default         =   -1  'True
      Height          =   495
      Left            =   2160
      TabIndex        =   1
      Top             =   4620
      Width           =   855
   End
   Begin VB.PictureBox picCourt 
      AutoRedraw      =   -1  'True
      Height          =   4455
      Left            =   0
      ScaleHeight     =   293
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   453
      TabIndex        =   0
      Top             =   0
      Width           =   6855
   End
   Begin VB.Label Label1 
      Caption         =   "Frames per second:"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   5
      Top             =   4920
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "Number of balls:"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   2
      Top             =   4560
      Width           =   1455
   End
Attribute VB_Name = "frmBounce1b"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private xmax As Integer
Private ymax As Integer
Private NumBalls As Integer
Private BallX() As Integer
Private BallY() As Integer
Private BallDx() As Integer
Private BallDy() As Integer
Private BallRadius() As Integer
Private BallColor() As Long
Private Playing As Boolean
Private NumPlayed As Long
Private BitmapWid As Long
Private BitmapHgt As Long
Private BitmapNumBytes As Long
Private Bytes() As Byte
' Bitmap Information
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
' Draw some random rectangles on the bacground.
Private Sub DrawBackground()
Dim i As Integer
Dim wid As Single
Dim hgt As Single
    ' Start with a clean slate.
    picCourt.Line (0, 0)-(picCourt.ScaleWidth, picCourt.ScaleHeight), picCourt.BackColor, BF
    ' Draw some rectangles.
    For i = 1 To 10
        hgt = 10 + Rnd * xmax / 3
        wid = 10 + Rnd * ymax / 3
        picCourt.Line (Int(Rnd * xmax), Int(Rnd * ymax))-Step(hgt, wid), QBColor(Int(Rnd * 16)), BF
    Next i
    ' Make the rectangles part of the permanent background.
    picCourt.Picture = picCourt.Image
End Sub
' Generate some random data.
Private Sub InitData()
Dim ball As Integer
Dim R As Integer
Dim clr As Integer
    ' See how many balls there should be.
    If Not IsNumeric(txtNumBalls.Text) Then _
        txtNumBalls.Text = "10"
    NumBalls = CInt(txtNumBalls.Text)
    ReDim BallRadius(1 To NumBalls)
    ReDim BallX(1 To NumBalls)
    ReDim BallY(1 To NumBalls)
    ReDim BallDx(1 To NumBalls)
    ReDim BallDy(1 To NumBalls)
    ReDim BallColor(1 To NumBalls)
    ' Set the initial ball data.
    For ball = 1 To NumBalls
        R = Int(10 * Rnd + 5)
        BallRadius(ball) = R
        BallX(ball) = Int((xmax - R + 1) * Rnd)
        BallY(ball) = Int((ymax - R + 1) * Rnd)
        BallDx(ball) = Int(21 * Rnd - 10)
        BallDy(ball) = Int(21 * Rnd - 10)
        clr = Int(15 * Rnd)
        If clr >= 7 Then clr = clr + 1
        BallColor(ball) = QBColor(clr)
    Next ball
End Sub
' Start the animation.
Private Sub cmdStart_Click()
    If Playing Then
        Playing = False
        cmdStart.Caption = "Stopped"
        cmdStart.Enabled = False
    Else
        cmdStart.Caption = "Stop"
        Playing = True
        InitData
        PlayData
        Playing = False
        cmdStart.Caption = "Start"
        cmdStart.Enabled = True
    End If
End Sub
' Play the animation.
Private Sub PlayData()
Dim ms_per_frame As Long
Dim start_time As Single
Dim stop_time As Single
Dim bm As BITMAP
    ' Draw a random background.
    DrawBackground
    ' Save the background bitmap data.
    GetObject picCourt.Image, Len(bm), bm
    BitmapWid = bm.bmWidthBytes
    BitmapHgt = bm.bmHeight
    BitmapNumBytes = BitmapWid * BitmapHgt
    ReDim Bytes(1 To bm.bmWidthBytes, 1 To bm.bmHeight)
    GetBitmapBits picCourt.Image, BitmapNumBytes, Bytes(1, 1)
    ' See how fast we should go.
    If Not IsNumeric(txtFramesPerSecond.Text) Then _
        txtFramesPerSecond.Text = "10"
    ms_per_frame = 1000 \ CLng(txtFramesPerSecond.Text)
    ' Start the animation.
    NumPlayed = 0
    start_time = Timer
    PlayImages ms_per_frame
    ' Display results.
    stop_time = Timer
    MsgBox "Displayed" & Str$(NumPlayed) & _
        " frames in " & _
        Format$(stop_time - start_time, "0.00") & _
        " seconds (" & _
        Format$(NumPlayed / (stop_time - start_time), "0.00") & _
        " FPS)."
End Sub
' Play the animation.
Private Sub PlayImages(ByVal ms_per_frame As Long)
Dim ball As Integer
Dim next_time As Long
    ' Get the current time.
    next_time = GetTickCount()
    ' Start the animation.
    Do While Playing
        NumPlayed = NumPlayed + 1
        ' Restore the background.
        SetBitmapBits picCourt.Image, BitmapNumBytes, Bytes(1, 1)
        ' Draw the balls.
        For ball = 1 To NumBalls
            picCourt.FillColor = BallColor(ball)
            picCourt.Circle _
                (BallX(ball), BallY(ball)), _
                BallRadius(ball), BallColor(ball)
        Next ball
        ' Move the balls for the next frame,
        ' keeping them within picCourt.
        For ball = 1 To NumBalls
            BallX(ball) = BallX(ball) + BallDx(ball)
            If BallX(ball) < BallRadius(ball) Then
                BallX(ball) = 2 * BallRadius(ball) - BallX(ball)
                BallDx(ball) = -BallDx(ball)
            ElseIf BallX(ball) > xmax - BallRadius(ball) Then
                BallX(ball) = 2 * (xmax - BallRadius(ball)) - BallX(ball)
                BallDx(ball) = -BallDx(ball)
            End If
            BallY(ball) = BallY(ball) + BallDy(ball)
            If BallY(ball) < BallRadius(ball) Then
                BallY(ball) = 2 * BallRadius(ball) - BallY(ball)
                BallDy(ball) = -BallDy(ball)
            ElseIf BallY(ball) > ymax - BallRadius(ball) Then
                BallY(ball) = 2 * (ymax - BallRadius(ball)) - BallY(ball)
                BallDy(ball) = -BallDy(ball)
            End If
        Next ball
        ' Wait until it's time for the next frame.
        next_time = next_time + ms_per_frame
        WaitTill next_time
    Loop
End Sub
Private Sub Form_Load()
    Randomize
    ' Set FillStyle to vbSolid.
    picCourt.FillStyle = vbSolid
End Sub
' Make the ball court nice and big.
Private Sub Form_Resize()
Const GAP = 3
    txtFramesPerSecond.Top = ScaleHeight - GAP - txtFramesPerSecond.Height
    Label1(0).Top = txtFramesPerSecond.Top
    txtNumBalls.Top = txtFramesPerSecond.Top - GAP - txtNumBalls.Height
    Label1(1).Top = txtNumBalls.Top
    cmdStart.Top = (txtNumBalls.Top + txtFramesPerSecond.Top + txtFramesPerSecond.Height - cmdStart.Height) / 2
    picCourt.Move 0, 0, ScaleWidth, txtNumBalls.Top - GAP
    xmax = picCourt.ScaleWidth - 1
    ymax = picCourt.ScaleHeight - 1
    picCourt.Picture = picCourt.Image
End Sub